
open Chipmunk.Low_level

(* this type represents the state of GameEngine,
 * there should be only one instance of this type,
 * when passed as parameter it is called 'ge' *)
type t =
	{         space        : cpSpace
	; mutable playersID    : Types.id_type
	; mutable players      : Player.t Types.IdMap.t
	;         playersMutex : Mutex.t
	; mutable objectsID    : Types.id_type
	; mutable objects      : Object.t Types.IdMap.t
	;         objectsMutex : Mutex.t
	}

let cpv = vec2d
let cpvi (x, y) = { cp_x = float x; cp_y = float y }

(* the step of the simulation
 * large step --> fast, but not precise and not stable
 * small step --> precise, more stable, but slow *)
let dt = Config.dt
(* just for numerical stability, more steps -- slower, but more stable *)
let steps = Config.steps

(* thread safe operations on players and objects maps *)
(* function 'registerPlayer' was merged with 'newPlayer' *)
let players ge =
	(* lock the players map -- enter critical section *)
	let () = Mutex.lock ge.playersMutex in
	(* do whatever we need to do, in this case
	 * copy the map i.e. copy the pointer to it *)
	let result = ge.players in
	(* leave critical section -- unlock the map *)
	let () = Mutex.unlock ge.playersMutex in
	result

let registerObject ge objct = 
	let () = Mutex.lock ge.objectsMutex in
	let result = ge.objectsID in
	let () = ge.objects <- Types.IdMap.add result objct ge.objects in
	let () = ge.objectsID <- ge.objectsID + 1 in
	let () = Mutex.unlock ge.objectsMutex in
	result

let objects ge = 
	let () = Mutex.lock ge.objectsMutex in
	let result = ge.objects in
	let () = Mutex.unlock ge.objectsMutex in
	result

let newPlayer ge =
	(* get the player id *)
	let () = Mutex.lock ge.playersMutex in
	let id = ge.playersID in
	let () = ge.playersID <- ge.playersID + 1 in
	let () = Mutex.unlock ge.playersMutex in
	(* create player *)
	let player = Player.create ge.space id in
	(* put it in the map *)
	let () = Mutex.lock ge.playersMutex in
	let () = ge.players <- Types.IdMap.add id player ge.players in
	let () = Mutex.unlock ge.playersMutex in
	(* return the id *)
	id
	
let unregisterPlayer ge id =
   let player = Types.IdMap.find id (players ge) in
   let () = cpSpaceRemoveShape ge.space player.Player.shape in
   let () = cpSpaceRemoveBody ge.space player.Player.body in
	let newPlayersMap = Types.IdMap.remove id (players ge) in
	let () = Mutex.lock ge.playersMutex in
	let () = ge.players <- newPlayersMap in
	let () = Mutex.unlock ge.playersMutex in
	()

let unregisterObject ge id =
	let newObjectsMap = Types.IdMap.remove id (objects ge) in	
	let () = Mutex.lock ge.objectsMutex in
	let () = ge.objects <- newObjectsMap in
	let () = Mutex.unlock ge.objectsMutex in
	()

let deleteObject delShape ge =
   let delBody = cpShapeGetBody delShape in
   let delID = cpBodyGetData delBody in
   try
   	let newObjectsMap = Types.IdMap.remove delID (objects ge) in
      Mutex.lock ge.objectsMutex;
      cpSpaceRemoveShape ge.space delShape;
      cpSpaceRemoveBody ge.space delBody;
      ge.objects <- newObjectsMap;
      Mutex.unlock ge.objectsMutex; 
      () 
   with 
      | _ -> Printf.printf "delete failed!\n"

let rec engineCommand ge cmd = match cmd with
	| Types.Data.List [
		Types.Data.String "Segment";
		Types.Data.Float startX;
		Types.Data.Float startY;
		Types.Data.Float endX;
		Types.Data.Float endY] -> 
			let obj = Object.Segment.create ge.space startX startY endX endY in
			let _ = registerObject ge (Object.Segment obj) in
			Types.Data.List []
	| Types.Data.List [
		Types.Data.String "Box";
		Types.Data.Float centerX;
		Types.Data.Float centerY;
		Types.Data.Float size;
		Types.Data.Float mass] -> 
			let obj = Object.Box.create ge.space centerX centerY size mass in
			let _ = registerObject ge (Object.Box obj) in
			Types.Data.List []
	| Types.Data.List [
		Types.Data.String "SetGravity";
		Types.Data.Float x;
		Types.Data.Float y] ->
			let () = cpSpaceSetGravity ge.space (cpv (x, y)) in
			Types.Data.List []
  | Types.Data.List [
		Types.Data.String "SetSpawnPoint";
		Types.Data.Float x;
		Types.Data.Float y] ->
			let () = Config.spawnX:=x in
			let () = Config.spawnY:=y in
			Types.Data.List []
	| Types.Data.List [
		Types.Data.String "SetStartHP";
		Types.Data.Float hp] ->
			let () = Config.startHP:=hp in
			Types.Data.List []
	| Types.Data.List [
		Types.Data.String "SetMaxHP";
		Types.Data.Float hp] ->
			let () = Config.maxHP:=hp in
			Types.Data.List []
   | Types.Data.List [
      Types.Data.String "Trigger";
      Types.Data.String strType;
      Types.Data.Float lbX;
      Types.Data.Float lbY;
      Types.Data.Float width;
      Types.Data.Float height;
      params ] ->
         let obj = Object.Trigger.create ge.space strType lbX lbY width height 
                   (ge.objectsID) params in
         let _ = registerObject ge (Object.Trigger obj) in
         Types.Data.List []
   | Types.Data.List [
      Types.Data.String "Bullet";
      Types.Data.String strType;
      Types.Data.Float spawnX;
      Types.Data.Float spawnY;
      Types.Data.Float direction;
      Types.Data.Int shooterID] ->
         let obj = Object.Bullet.create ge.space strType spawnX spawnY direction 
                   shooterID (ge.objectsID) in
         let _ = registerObject ge (Object.Bullet obj) in
         Types.Data.List []
	| _ -> Types.Data.List [Types.Data.String "Unknown command!"; cmd]

let rec adminCommand ge cmd = match cmd with
	| Types.Data.List [
		Types.Data.String "repeat";
		Types.Data.Float x;
		cmd' ] -> 
			let n = int_of_float x in
			let () = for ii = 1 to n do
					let _ = adminCommand ge cmd' in ()
				done
			in Types.Data.List []
	| _ -> engineCommand ge cmd

let serverCommand ge cmd =
  match cmd with
    | Types.Data.String "getObjects" ->
      Types.Data.List (List.rev_map (fun (_, v) -> Object.show v)
			 (Types.IdMap.bindings (objects ge)))
    | Types.Data.String "getPlayers" ->
      Types.Data.List (List.rev_map (fun (_, v) -> Player.show v)
			 (Types.IdMap.bindings (players ge)))
    | Types.Data.String "getScores" ->
      Types.Data.List (List.rev_map (fun (_, v) -> Player.getScore v)
			 (Types.IdMap.bindings (players ge)))
    | _ -> assert false

let rec playerCommand ge player cmd = 
	let player = Types.IdMap.find player (players ge) in
	match cmd with
	| Types.Data.String "fire" -> 
	        let pos = cpBodyGetPos player.Player.body in
                let obj = Object.Bullet.create 
		  ge.space player.Player.weapon 
		  pos.cp_x pos.cp_y 
		  (player.Player.crosshair)
		  (cpBodyGetData player.Player.body) 
        ge.objectsID
           in
           let _ = Printf.printf "firing at %.2f\n" player.Player.crosshair in
		let _ = registerObject ge (Object.Bullet obj) in
		Types.Data.List []
	| _ -> Player.command player cmd

(* creates the frame which encloses the game space *)
let createFrame ge = 
	(* create body for the frame with infinite mass and momentum *)
	let frameBody = cpBodyNew infinity infinity in
	(* do not add body to space -> frame is static, no gravity *)
	(* create shapes for the body, just simple square *)
	let frameShape1 = cpSegmentShapeNew frameBody (cpvi(1,1)) (cpvi(1,0)) 0.0 in
	let frameShape2 = cpSegmentShapeNew frameBody (cpvi(1,0)) (cpvi(0,0)) 0.0 in
	let frameShape3 = cpSegmentShapeNew frameBody (cpvi(0,0)) (cpvi(0,1)) 0.0 in
	let frameShape4 = cpSegmentShapeNew frameBody (cpvi(0,1)) (cpvi(1,1)) 0.0 in
	let () = cpShapeSetElasticity frameShape1 1.0 in
	let () = cpShapeSetElasticity frameShape2 1.0 in
	let () = cpShapeSetElasticity frameShape3 1.0 in
	let () = cpShapeSetElasticity frameShape4 1.0 in
	let () = cpShapeSetFriction frameShape1 1.0 in
	let () = cpShapeSetFriction frameShape2 1.0 in
	let () = cpShapeSetFriction frameShape3 1.0 in
	let () = cpShapeSetFriction frameShape4 1.0 in
	(* add the shape to space, so it can interact *)
	let () = cpSpaceAddStaticShape ge.space frameShape1 in
	let () = cpSpaceAddStaticShape ge.space frameShape2 in
	let () = cpSpaceAddStaticShape ge.space frameShape3 in
	let () = cpSpaceAddStaticShape ge.space frameShape4 in
	()  

let init mapFilename = 
	(* init physics engine *)
	let () = cpInitChipmunk () in
	let () = cpResetShapeIdCounter () in
	(* create space for our objects *)
	let space = cpSpaceNew () in
	let () = cpSpaceResizeStaticHash space 20.0 999 in (* TODO check parameters *)
	let () = cpSpaceSetGravity space (cpv (0.0 , -.Config.gravity)) in
	let () = set_cp_collision_slop 1e-4 in
	(* build the state of GameEngine *)
	let ge = 
		{ space
		; playersID = 0
		; players = Types.IdMap.empty
		; playersMutex = Mutex.create ()
		; objectsID = 0
		; objects = Types.IdMap.empty
		; objectsMutex = Mutex.create ()
		}
	in 
	(* == init collision handler == *)
   (* registering all nonstandard collision handlers *)
   (* collision type is 0 for walls, 1 for players, Bullet.collisionType for bullets,
    * 100..Trigger.maxType for triggers *)
	let () = Callback.register "chPlayerPlayer" (Collision.chPlayerPlayer (players) ge) in
	let () = cpSpaceAddCollisionHandler space 1 1 "chPlayerPlayer" in	
   (* handler for non-colliding objects *)
   let () = Callback.register "chNoCollision" (Collision.chNoCollision ge) in
   (* generate and register collision handler for each trigger type *)
   let () = for ii=100 to Object.Trigger.maxType do
      let collHndName = "chTriggerPlayer" ^ (string_of_int ii) in
      Callback.register collHndName 
         (Collision.chTriggerPlayer (players) (objects) (adminCommand) ii ge);
      (* handler for collisions of trigger type ii with player *)
      cpSpaceAddCollisionHandler space ii 1 collHndName;
      (* don't collide triggers with bullets and boxes *)
      cpSpaceAddCollisionHandler space ii Object.Bullet.collisionType "chNoCollision";
      cpSpaceAddCollisionHandler space ii 0 "chNoCollision"
   done in
   (* collision handler for bullets and players *)
   let () = Callback.register "chBulletPlayer" (
      Collision.chBulletPlayer (players) (objects) (deleteObject) ge) in
   let () = cpSpaceAddCollisionHandler space Object.Bullet.collisionType 1 "chBulletPlayer" in
   (* ch for players and walls *)
   let () = Callback.register "chPlayerWall" (Collision.chPlayerWall (players) ge) in
   let () = cpSpaceAddCollisionHandler space 0 1 "chPlayerWall" in
   (* ch for bullets and walls *)
   let () = Callback.register "chBulletWall" (Collision.chBulletWall (deleteObject) ge) in
   let () = cpSpaceAddCollisionHandler space Object.Bullet.collisionType 0 "chBulletWall" in
	(* create square game border *)
	let () = createFrame ge in
	(* fin *)
	ge

let step ge = 
	let space = ge.space in
	(* iter through the objects in space; we may need another type of objects
	 * -- 'mindless' -- if this function is too slow *)
	let () = Types.IdMap.iter 
		(fun key player -> Player.step player) 
		(players ge) 
	in
	let () = Types.IdMap.iter
		(fun key objct -> Object.step objct)
		(objects ge)
	in
	(* calculate dt for the system *)
	let dt = dt /. (float steps) in
	let () = 
	(* do 'steps' passes for numerical stability *)
		for ii = 0 to pred steps do	
			cpSpaceStep ~space ~dt
		done
	in ()

